COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE  ASD
C00007 ENDMK
C⊗;
	TITLE  ASD
	ENTRY ASD
	EXTERNAL ALLIO.	
M1:	MOVE L
	JUMPGE M2
	JRST M3
M2:	AOS C
	MOVE P
	MOVE 1,C
	MOVEM I(1)
	MOVE A
	MOVE 1,C
	MOVEM PO+5(1)
	MOVE R
	MOVE 2,2(16)
	TLNN 2,40
	TLNN 2,100
	JSA 16,FLOAT
	JUMP 0,R
	MOVE 1,C
	MOVEM AL+5(1)
	MOVE P
	JUMPL P2
	MOVEI 6
	CAMG C
	JRST P1
	JRST M3
P1:	JRST P2
	ASCII	/(6(1X,I1,A5,1H=2PE12.5))/
P2:	MOVEI 1,P1
	OUT. 1,-3
	MOVEI 15,1
M8:	MOVEM 15,I
	MOVE 1,I
	DATA. I(1)
	DATA. 2,PO+5(1)
	DATA. 2,AL+5(1)
	CAIGE 15,6
	AOJA 15,M8
	FIN. 0
	SETZM C
	MOVEI 15,1
	MOVEM 15,I
M11:	SETZM I(15)
	SETZM PO+5(15)
	SETZM AL+5(15)
	CAIGE 15,6
	AOJA 15,M11
M3:	MOVSI 16,TEMP.
	BLT 16,16
	JRA 16,3(16)
ASD:	JUMP 0
	MOVEI TEMP.
	BLT TEMP.+16
	MOVEI TEMP.+16
	PUSH @0(16)
	PUSH @1(16)
	PUSH @2(16)
	JRST M1
TEMP.:	BLOCK 17
P:	0
A:	0
R:	0
L:	0
C:	0
X:	0
I:	0
PO:	BLOCK 6
AL:	BLOCK 6
RE:	BLOCK 6
	EXTERNAL FLOAT
	EXTERNAL FLOUT.
	END
	SUBROUTINE ACTES(RO,D,V1,V2)

	DIMENSION DIF(-1/1),Z(1783)

	REAL D,DP,DEN,DIF,F1,F2,F3,F4,F5,F6,F7,
	1 G1,G2,G6,CL,SL,CW,SW,COH,
	1 RO,ROP,RO2,VAR,V1,V2,V1P,V2P,V,T,
	1 A0,A1,A2,A3,A4,A5,A6,A7,
	1 B0,B1,B2,B3,B4,B5,B6,B7

	INTEGER I,K

	COMMON /EDGEC/ B0,B1,B2,B3,B4,B5,B6,B7,Z

	G1=.4082483
	G2=.7071068
	G6=.5773503
	A1=B1/G1
	A2=B2/G2
	A3=B3/G2
	A4=B4/G2
	A5=B5/G2
	A6=B6/G6
	A7=B7/G6
	VAR=0.03

	DO 60 K=1,3
	DO 40 I=-1,1
	IF(I.EQ.0 .AND. K.GT.1) GOTO 40

	ROP=RO
	DP=D
	CL=V1
	SL=V2

	IF(K.NE.1) GOTO 10
	V1P=V1-V2*I*VAR
	V2P=V2+V1*I*VAR
	V=SQRT(V1P**2+V2P**2)
	CL=V1P/V
	SL=V2P/V
	GOTO 30
10	IF(K.NE.2) GOTO 20
	DP=D*(1.+I*VAR)
	GOTO 30
20	ROP=RO+I*VAR

30	RO2=ROP**2
	DEN=1.+2.*RO2
	SW=2.8284272*ROP/DEN
	CW=(1.-2.*RO2)/DEN
	T=DP*0.76749504*(1.-RO2)**2*DEN
	F1=G1*T*SW
	F2=G2*T*CL
	F3=G2*T*SL
	F4=G2*T*CL*CW
	F5=G2*T*SL*CW
	F6=G6*T*(CL**2-SL**2)*SW
	F7=G6*T*2.*SL*CL*SW

	IF(I.NE.0) GOTO 35
	CALL ASD(4,'A1',A1)
	CALL ASD(4,'F1',F1)
	CALL ASD(4,'A2',A2)
	CALL ASD(4,'A3',A3)
	CALL ASD(4,'A4',A4)
	CALL ASD(4,'A5',A5)
	CALL ASD(4,'A6',A6)
	CALL ASD(4,'A7',A7)
	CALL ASD(4,'F2',F2)
	CALL ASD(4,'F3',F3)
	CALL ASD(4,'F4',F4)
	CALL ASD(4,'F5',F5)
	CALL ASD(4,'F6',F6)
	CALL ASD(4,'F7',F7)
	COH=(A1*F1+A2*F2+A3*F3+A4*F4+A5*F5+A6*F6+A7*F7)/
	1 SQRT((A1**2+A2**2+A3**2+A4**2+A5**2+A6**2+A7**2)*
	2 (F1**2+F2**2+F3**2+F4**2+F5**2+F6**2+F7**2))
	CALL ASD(4,'COH',COH)

35	DIF(I)=(A1-F1)**2+(A2-F2)**2+(A3-F3)**2+
	1 (A4-F4)**2+(A5-F5)**2+(A6-F6)**2+(A7-F7)**2
40	CONTINUE

	IF(DIF(0).GT.DIF(-1).OR.DIF(0).GT.DIF(1)) GOTO 43
	IF((DIF(-1)-DIF(0))*(DIF(0)-DIF(1)).LT.0) GOTO 45
43	CALL ASD(1,'DIF-1',DIF(-1))
	CALL ASD(1,'DIF 0',DIF(0))
	CALL ASD(1,'DIF+1',DIF(1))
	CALL ASD(2,'K',K)
	GOTO 60
45	CALL ASD(3,'RO',RO)
60	CONTINUE
	RETURN
	END